home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 355 / source / flsclr / flsclr.mod < prev    next >
Text File  |  1990-02-02  |  29KB  |  990 lines
  1. (* this is a custom file directory that was extracted from another more *)
  2. (* extensive program I designed. The standard item selector that is in  *)
  3. (* has its limitations, one of the biggest is that it will only load in *)
  4. (* the first 100 file names!,if you have a hard disk like me and have a *)
  5. (* lot of source code files, then the standard item selector will not   *)
  6. (* display all your files!                                              *)
  7. (* If you find this you find this program useful, a donation would be   *)
  8. (* appreciated. You will discover the program is helpful to those of you*)
  9. (* that have modula 2(TDI's Version) and want to do some programming    *)
  10. (* using the AES libraries. The Procedures have been some documentation *)
  11. (* , but are not fully documented. If you want a more detailed explan-  *)
  12. (* ation of a particular procedure, leave a message and I'll get back   *)
  13. (* to you.                                                              *)
  14. (*                                                                      *)
  15. (* Dan Mckee                                                            *)
  16. (* 14A Elm St.                                                          *)
  17. (* Mt. Home AFB, ID 83648  phone: 1-208-832-4504                        *)
  18. (* Genie - D.M.                                                         *)
  19. (* Dephi - elmac                                                        *)
  20. (* Compuserve - 75766,1515                                              *)
  21. (* Rattle Snake BBS - 1-208-587-7603(65 meg of storage!!)               *)
  22.  
  23.  
  24.  
  25.  
  26. MODULE FileSelector;
  27. (*$A+,$S-,$T-*)
  28. FROM Storage IMPORT ALLOCATE,DEALLOCATE, CreateHeap;
  29. FROM AESResources IMPORT ResourceLoad,ResourceFree,ResourceGetAddr;
  30. FROM SYSTEM IMPORT ADDRESS,ADR,BYTE;
  31. FROM AESForms IMPORT FormDo,FormCenter,FormAlert,FormDialogue;
  32. FROM AESObjects IMPORT ObjectDraw,ObjectOffset,ObjectChange;
  33. FROM AESGraphics IMPORT GrafDragBox,GrafMouseKeyboardState,GrafMouse;
  34. FROM GEMAESbase IMPORT TEdInfo,Arrow,HourGlass,AESCallResult;
  35. FROM BIOS IMPORT DriveMap,DriveSet,BCosStat,Device;
  36. FROM InOut IMPORT WriteString,WriteLn,WriteCard,OpenOutputFile;
  37. FROM GEMDOS IMPORT GetDrv,SetDrv,SFirst,SNext,SetDTA,Alloc;
  38. FROM Strings IMPORT String,Length,Concat,Compare,CompareResults,Delete,Pos;
  39. FROM LongInOut IMPORT WriteLongCard;
  40.  
  41. CONST
  42.  
  43.     (* Resource file constances *)
  44.         tree1    = 0;   (* form/dialog *)
  45.         fpath    = 1;   (* BOXTEXT in tree TREE1 *)
  46.         fup      = 2;   (* BOXTEXT in tree TREE1 *)
  47.         ftoname  = 5;   (* FTEXT in tree TREE1 *)
  48.         fwind    = 6;   (* BOX in tree TREE1 *)
  49.         fname2   = 7;   (* TEXT in tree TREE1 *)
  50.         fname3   = 8;   (* TEXT in tree TREE1 *)
  51.         fname4   = 9;   (* TEXT in tree TREE1 *)
  52.         fname5   = 10;  (* TEXT in tree TREE1 *)
  53.         fname6   = 11;  (* TEXT in tree TREE1 *)
  54.         fname7   = 12;  (* TEXT in tree TREE1 *)
  55.         fname8   = 13;  (* TEXT in tree TREE1 *)
  56.         fname9   = 14;  (* TEXT in tree TREE1 *)
  57.         fname10  = 15;  (* TEXT in tree TREE1 *)
  58.         fname11  = 16;  (* TEXT in tree TREE1 *)
  59.         fname12  = 17;  (* TEXT in tree TREE1 *)
  60.         fname13  = 18;  (* TEXT in tree TREE1 *)
  61.         fntrack  = 19;  (* BOX in tree TREE1 *)
  62.         fnslider = 20;  (* BOX in tree TREE1 *)
  63.         drivea   = 21;  (* BOXTEXT in tree TREE1 *)
  64.         driveb   = 22;  (* BOXTEXT in tree TREE1 *)
  65.         drivec   = 23;  (* BOXTEXT in tree TREE1 *)
  66.         drived   = 24;  (* BOXTEXT in tree TREE1 *)
  67.         drivee   = 25;  (* BOXTEXT in tree TREE1 *)
  68.         drivef   = 26;  (* BOXTEXT in tree TREE1 *)
  69.         driveg   = 27;  (* BOXTEXT in tree TREE1 *)
  70.         driveh   = 28;  (* BOXTEXT in tree TREE1 *)
  71.         drivei   = 29;  (* BOXTEXT in tree TREE1 *)
  72.         drivej   = 30;  (* BOXTEXT in tree TREE1 *)
  73.         drivek   = 31;  (* BOXTEXT in tree TREE1 *)
  74.         drivel   = 32;  (* BOXTEXT in tree TREE1 *)
  75.         drivem   = 33;  (* BOXTEXT in tree TREE1 *)
  76.         driven   = 34;  (* BOXTEXT in tree TREE1 *)
  77.         driveo   = 35;  (* BOXTEXT in tree TREE1 *)
  78.         drivep   = 36;  (* BOXTEXT in tree TREE1 *)
  79.         fprint   = 37;  (* BOXTEXT in tree TREE1 *)
  80.         fdown    = 39;  (* BOXTEXT in tree TREE1 *)
  81.         exit     = 38;
  82.         
  83.         Normal    = 0;
  84.         selected  = 1;
  85.  
  86. TYPE
  87.  
  88.    DirFileAttributes  = (ReadWrite, WriteProt, HiddenEntry, HiddenSystem,
  89.                            Volume, SubDirectory, Archive);
  90.      DirEntryPtr        = POINTER TO DirEntryDef;
  91.      DirEntryDef        = RECORD
  92.        Name:            String;
  93.        Attr:            BYTE;
  94.        Time:            CARDINAL;
  95.        Date:            CARDINAL;
  96.        Size:            LONGCARD;
  97.        Library:         DirEntryPtr;
  98.        Owner:           DirEntryPtr;
  99.        Back:            DirEntryPtr;
  100.        Next:            DirEntryPtr;
  101.        Left:            DirEntryPtr;
  102.        Right:           DirEntryPtr;
  103.      END;
  104.  
  105.  
  106.   etree = POINTER TO TEdInfo;
  107.   
  108.  objtree = RECORD
  109.               next      : INTEGER;
  110.               head      : INTEGER;
  111.               tail      : INTEGER;
  112.               type      : INTEGER;
  113.               flags     : CARDINAL;
  114.               state     : CARDINAL;
  115.               spec      : etree;
  116.               x         : CARDINAL;
  117.               y         : CARDINAL;
  118.               width     : CARDINAL;
  119.               height    : CARDINAL;
  120.              END;
  121.              
  122.   Tree = POINTER TO ARRAY[1..50] OF objtree;
  123.        
  124.   objstate = (Selected);
  125.         
  126.   pathrecord = RECORD
  127.                 reserved : ARRAY[0..20] OF BYTE;
  128.                 attrib   : BYTE;
  129.                 time     : CARDINAL;
  130.                 date     : CARDINAL;
  131.                 size     : LONGCARD;
  132.                 name     : String;
  133.                END;
  134.     oned = ARRAY[1..500] OF INTEGER;
  135.     twod = ARRAY[1..500],[1..2] OF INTEGER;
  136.  
  137. VAR 
  138.   tree1ptr : Tree;
  139.   
  140.    handle,x,y,w,h,showit,result,oldyoff,index,fcount,th,sh,fnametemp,ii,
  141.    apid,i1,j,j1,k,p,t,i : INTEGER;
  142.   
  143.              
  144.   d : [0..31];
  145.   drv : DriveSet;
  146.   loaded,done,initialized,s : BOOLEAN;
  147.   
  148.   drive,defaultdrive,count,ct,attr : CARDINAL;
  149.   
  150.   dtarecord : pathrecord; 
  151.    
  152.   swidth,tswidth,ttswidth : REAL;
  153.  
  154.   fn,rpath,temp,temp2 : ARRAY[0..300] OF String;
  155.   atrib : ARRAY[0..100] OF CARDINAL;
  156.   
  157.   filename,match,rfarray,r1,r2,r3,r4,temp1,result2
  158.   ,p1,p2,p3,p4,ffpath,ppath,Temp1,Temp2,Temp3,filearray,
  159.   globlepath,clear,ptextstr,pathstr,Path,
  160.   presult,pathdrive,
  161.   fffpath,directchr
  162.   : String;
  163.   path : ARRAY[0..300] OF String;
  164.   tsize : LONGCARD;
  165.   FreeMemory : ADDRESS;
  166.   
  167.   n : oned;
  168.   s9 : twod;
  169.  
  170. PROCEDURE switch(VAR a,b: String ; VAR s1 : BOOLEAN);
  171.   
  172. VAR
  173.  t : String;
  174.  
  175.   BEGIN
  176.     t := a;
  177.     a := b;
  178.     b := t;
  179.     s1 := NOT s1;
  180.   END switch;
  181.  
  182. PROCEDURE save1(VAR q : INTEGER ;VAR s8 : twod ;a ,k1 : INTEGER);
  183.  
  184.   BEGIN
  185.     q := q+1;
  186.     s8[q,1] := a+1;
  187.     s8[q,2] := k1
  188.   END save1;
  189.  
  190. PROCEDURE restore(s8:twod ; VAR i2,j2,q : INTEGER);
  191.  
  192.   BEGIN
  193.     i2 := s8[q,1];
  194.     j2 := s8[q,2];
  195.     q := q - 1
  196.   END restore;
  197.  
  198. PROCEDURE init(VAR a,b,a1,b1 : INTEGER ; VAR es : BOOLEAN);
  199.  
  200.  BEGIN
  201.     a := a1;
  202.     b := b1;
  203.     es := FALSE;
  204.  END init;
  205.  
  206. PROCEDURE sort;
  207.  
  208. BEGIN  
  209.   
  210.   REPEAT
  211.     IF (Compare(path[i],path[j]) = Greater) THEN switch(path[i],path[j],s);END;
  212.     IF s THEN i := i + 1
  213.            ELSE j := j - 1;END;
  214.   UNTIL  i = j;
  215.     IF NOT(i+1 >= j1) THEN save1(p,s9,i,j1);END;
  216.     j1 := i - 1;
  217.     IF i1 < j1 THEN
  218.         init(i,j,i1,j1,s);
  219.         sort;
  220.     END;
  221.     IF p <> 0 THEN
  222.        restore(s9,i1,j1,p);
  223.        init(i,j,i1,j1,s);
  224.        j := ii;
  225.        sort;
  226.     END;
  227.   END sort;
  228.  
  229. (* Load the directory into an array *)   
  230.              
  231. PROCEDURE MakePath(VAR ppath : ARRAY OF CHAR);
  232.  
  233. VAR
  234.   addr : ADDRESS;
  235.   pathdrive,presult,match,directchr : String;
  236.   obspec : etree;
  237.   i2,l : INTEGER;
  238.   atrib,where,start : CARDINAL;
  239.    
  240. BEGIN
  241.   (* reset variables *)
  242.   ii := 0;
  243.   tswidth := 0.0;
  244.   ttswidth := 0.0;
  245.   (* get the current drive *)
  246.   pathdrive := CHR(ORD(defaultdrive) + ORD('A'));
  247.   Concat(pathdrive,':',presult);
  248.   (* set up the path string *)
  249.   Concat(presult,ppath,pathstr);
  250.   addr := ADR(dtarecord);
  251.   SetDTA(addr);
  252.   GrafMouse(HourGlass,NIL);
  253.   (* get the first occurance of specified path *)
  254.   SFirst(pathstr,16,result);
  255.   IF result >= 0 THEN
  256.      REPEAT
  257.        WITH dtarecord DO;
  258.        (* if the file name is not a . or .. then load in the file name *)
  259.          IF (Compare(name,'.') # Equal) AND (Compare(name,'..')
  260.                                                        # Equal) THEN
  261.             INC(ii);
  262.             path[ii] := name;
  263.             atrib := CARDINAL(attrib);
  264.             directchr := CHR(5);
  265.             Concat(directchr," ",directchr);
  266.             (* if the file name attribute is a sub directory, add a *)
  267.             (* CHR(5) to the front of the name to indicate a folder *)
  268.             IF atrib = 16 THEN
  269.                Concat(directchr,path[ii],rpath[ii]);
  270.             ELSE
  271.                (* add a space to the beginning to the file name to keep *)
  272.                (* all the file names lined up                           *)
  273.                Concat('  ',path[ii],rpath[ii]);
  274.             END; (* IF atrib *)
  275.             path[ii] := rpath[ii];
  276.             (* add spaces to the end of the file name if the length is *)
  277.             (* less than 14, why? it makes the file name selecting and *)
  278.             (* deselecting visually more pleasent.                     *)
  279.             IF Length(rpath[ii]) < 14 THEN
  280.                FOR l := Length(rpath[ii]) + 1 TO 14 DO
  281.                      Concat(rpath[ii],' ',rpath[ii]);
  282.                END; (* FOR l *)
  283.             END; (* IF Length *)   
  284.             path[ii] := rpath[ii];
  285.          END; (* IF (Compare *)      
  286.        END; (* WITH *)  
  287.        (* limit the amount of files to 300 *)
  288.        IF ii < 300 THEN 
  289.          SNext(result);
  290.        ELSE 
  291.          showit := FormAlert(1,'[1][The maximum number of files|has been exceeded!][ OK ]');
  292.          result := -1;END;
  293.      UNTIL result < 0;
  294.   END;  (* IF *)
  295.       match := ' ';
  296.       start := 0;
  297.       where := 0;
  298.       FOR i2 := 0 TO Length(pathstr) DO
  299.           IF Pos(pathstr,match,start,where) THEN
  300.           Delete(pathstr,where,1); END;
  301.           INC(start); 
  302.       END; (* FOR *)
  303.       IF ii > 1 THEN
  304.          i1 := 1;
  305.          i := 0;
  306.          p := 0;
  307.          j1 := ii;
  308.          init(i,j,i1,j1,s);
  309.           j := ii;
  310.           (* sort the file names *)
  311.          sort;
  312.       END; (* IF ii > *)  
  313.       (* find the address of the Drive Path's TEditInfo ptext *)
  314.       (* string *)
  315.       obspec := etree(tree1ptr^[fpath + 1].spec);
  316.       (* set the ptext to the current drive path *)
  317.       obspec^.ptext := ADR(pathstr);
  318.       IF initialized THEN
  319.       ObjectDraw(tree1ptr,fpath,1,x,y,w,h);END;
  320.       GrafMouse(Arrow,NIL);
  321. END MakePath;
  322.  
  323. (* find the state of an object *)
  324.  
  325. PROCEDURE ChecktheState(tree,index : INTEGER) : BITSET;
  326.  
  327. VAR
  328.   treeaddr : Tree;
  329.  
  330. BEGIN
  331.   ResourceGetAddr(0,tree,treeaddr);
  332.   RETURN BITSET(treeaddr^[index + 1].state);
  333. END ChecktheState;
  334.    
  335. (* get the state of an object *)
  336.  
  337. PROCEDURE GetObjectState(tree,index : INTEGER ; mask : objstate) : BOOLEAN;
  338.  
  339. TYPE
  340.    state = SET OF objstate;
  341.  
  342. VAR
  343.   value : BITSET;
  344.   treeaddr : Tree;
  345.     
  346. BEGIN
  347.   ResourceGetAddr(0,tree1,tree1ptr);
  348.   value := ChecktheState(tree,index);
  349.   RETURN (mask IN state(value));
  350. END GetObjectState;  
  351.  
  352. (* calulate the size of the file selector's slider *)
  353.  
  354. PROCEDURE CalcSliderSize;
  355.  
  356. BEGIN
  357.    (* find the height of the file selector's track *)
  358.    th := tree1ptr^[fntrack + 1].height;
  359.    (* if the number of file names is less than 12 then the slider *)
  360.    (* is the same size as the track *)
  361.   IF ii < 12 THEN
  362.      tree1ptr^[fnslider + 1].height := th;
  363.   ELSE
  364.   (* calulate the slider height, track divided by the # of files *)
  365.      swidth := FLOAT(CARDINAL(th))/FLOAT(CARDINAL(ii));
  366.      swidth := swidth * 12.0;
  367.      ttswidth := swidth;
  368.      (* ensure the slider has a minimum size *)
  369.      IF swidth < 5.00 THEN
  370.         tree1ptr^[fnslider + 1].height := 5;
  371.         swidth := swidth/12.0;
  372.      ELSE
  373.         tree1ptr^[fnslider + 1].height := INTEGER(TRUNC(swidth));
  374.         swidth := swidth/12.0;
  375.      END;
  376.      sh := tree1ptr^[fnslider + 1].height;   
  377.   END; (* IF ELSE *)
  378.   tree1ptr^[fnslider + 1].y := 0;
  379.   IF initialized THEN ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);END;
  380. END CalcSliderSize;
  381.   
  382. PROCEDURE ClearSelection;
  383.  
  384. VAR
  385.   clear : String;
  386.   obspec : etree;
  387.   
  388. BEGIN
  389.   clear := '';
  390.   obspec := etree(tree1ptr^[ftoname + 1].spec);
  391.   obspec^.ptext := ADR(clear);
  392.   ObjectDraw(tree1ptr,ftoname,1,x,y,w,h);
  393. END ClearSelection;    
  394.  
  395. (* show the current  path *)
  396.  
  397. PROCEDURE ShowPath(VAR ppath : ARRAY OF CHAR);
  398.  
  399. VAR
  400.   addr : ADDRESS;
  401.   pathdrive,presult,match,directchr : String;
  402.   obspec : etree;
  403.   atrib,where,start : CARDINAL;
  404.   l,i2 : INTEGER;
  405.    
  406. BEGIN
  407.   pathdrive := CHR(ORD(defaultdrive) + ORD('A'));
  408.   Concat(pathdrive,':',presult);
  409.   Concat(presult,ppath,pathstr);
  410.       match := ' ';
  411.       start := 0;
  412.       where := 0;
  413.       FOR i2 := 0 TO Length(pathstr) DO
  414.           IF Pos(pathstr,match,start,where) THEN
  415.           Delete(pathstr,where,1); END;
  416.           INC(start); 
  417.       END; (* FOR *)
  418.       obspec := etree(tree1ptr^[fpath + 1].spec);
  419.       obspec^.ptext := ADR(pathstr);
  420.       IF initialized THEN
  421.       ObjectDraw(tree1ptr,fpath,1,x,y,w,h);END;
  422.       GrafMouse(Arrow,NIL);
  423. END ShowPath;
  424.  
  425. (* display the first 12 file names in the directory *)
  426.     
  427. PROCEDURE Directory;
  428.  
  429. VAR
  430.   i : INTEGER;
  431.   obspec : etree;
  432.   
  433. BEGIN
  434.      FOR i := 1 TO 12 DO
  435.         obspec := etree(tree1ptr^[fname2 + i].spec);
  436.         obspec^.ptext := ADR(path[i]);END;
  437. END Directory;         
  438.  
  439. (* clear out the array before loading in the new path *)
  440. PROCEDURE ClearArray;
  441.  
  442. VAR
  443.   clearstr : String;
  444.   obspec : etree;
  445.   i : INTEGER;
  446.   
  447. BEGIN
  448.   clearstr := '           ';
  449.   FOR i := 0 TO ii DO
  450.       path[i] := clearstr;
  451.       obspec := etree(tree1ptr^[fname2 + 1].spec);
  452.       obspec^.ptext := ADR(path[i]);
  453.   END; (* FOR *)
  454.   ii := 0;
  455.   tswidth := 0.0;
  456.   ttswidth := 0.0; 
  457. END ClearArray;
  458.    
  459.  
  460. (* scroll down the directory one file name at a time *)
  461.   
  462. PROCEDURE ScrollDown;
  463.  
  464. VAR
  465.   obspec : etree;
  466.   i,j : INTEGER;
  467.   thestring : String;
  468.  
  469. BEGIN
  470.   ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
  471.   ObjectDraw(tree1ptr,fnametemp,1,x,y,w,h);
  472.   j := 0;
  473.   IF fcount < ii THEN
  474.      DEC(index,11);
  475.      FOR i := 1 TO 12 DO
  476.        obspec := etree(tree1ptr^[fname2 + i].spec);
  477.        INC(index);
  478.        obspec^.ptext := ADR(path[index]);
  479.        ObjectDraw(tree1ptr,fname2 + j,1,x,y,w,h);
  480.        INC(j);
  481.      END; (* FOR *)
  482.      INC(fcount);
  483.      tswidth := tswidth + swidth;
  484.      tree1ptr^[fnslider + 1].y := INTEGER(TRUNC(tswidth));
  485.      ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);
  486.   END; (* IF *)
  487. END ScrollDown;
  488.  
  489. (* scroll up the directory one name at a time *)
  490.  
  491. PROCEDURE ScrollUp;
  492.  
  493. VAR 
  494.   i,j : INTEGER;
  495.   obspec : etree;
  496.   
  497. BEGIN
  498.   ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
  499.   IF fcount > 12 THEN
  500.      i := 12;
  501.      j := 0;
  502.      INC(index,11);
  503.      WHILE i # 0 DO
  504.          obspec := etree(tree1ptr^[fname2 + i].spec);
  505.          obspec^.ptext := ADR(path[index - 12]);
  506.          ObjectDraw(tree1ptr,fname13 - j,1,x,y,w,h);
  507.          DEC(i);
  508.          INC(j);
  509.          DEC(index);
  510.      END; (* WHILE *)
  511.      DEC(fcount);
  512.      tswidth := tswidth - swidth;
  513.      IF tswidth < 0.0 THEN tswidth := 0.0; END;
  514.      tree1ptr^[fnslider + 1].y := INTEGER(TRUNC(tswidth));
  515.      ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);      
  516.   END; (* IF *)
  517. END ScrollUp;
  518.  
  519. (* scroll through the directory a page at a time *)
  520.  
  521. PROCEDURE Scroll12;
  522.  
  523. VAR
  524.   obspec : etree;
  525.   temp,i,mx,my,mstate,kstate,xoff,yoff : INTEGER;
  526.   thestring : String;
  527.   
  528. BEGIN
  529.   ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
  530.   (* find the location of the mouse *)
  531.   GrafMouseKeyboardState(mx,my,mstate,kstate);
  532.   (* find the location of the slider *)
  533.   ObjectOffset(tree1ptr,fnslider,xoff,yoff);
  534.   (* mouse coordinates are below the slider, scroll down *)
  535.   IF my > yoff THEN
  536.     IF fcount < ii THEN
  537.        temp := ii - fcount;
  538.        IF temp < 12 THEN
  539.           temp := 12 - temp;
  540.           fcount := fcount - temp;
  541.           index := index - temp;
  542.        END;   
  543.        FOR i := 1 TO 12 DO
  544.            INC(fcount);
  545.            INC(index);
  546.            obspec := etree(tree1ptr^[fname2 + i].spec);
  547.            obspec^.ptext := ADR(path[index]);
  548.            tswidth := tswidth + swidth;
  549.        END;  (* FOR *)
  550.        IF tswidth + FLOAT(CARDINAL(sh)) > FLOAT(CARDINAL(th)) THEN
  551.           tswidth := FLOAT(CARDINAL(th)) - ttswidth;
  552.        END;
  553.        tree1ptr^[fnslider + 1].y := INTEGER(TRUNC(tswidth));
  554.        ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);
  555.        ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
  556.     END;
  557.   ELSE
  558.    (* mouse coordinated are above the slider, scroll up *)
  559.      IF fcount > 12 THEN
  560.        i := 12;
  561.        IF index < 24 THEN
  562.           temp := 24 - index;
  563.           index := index + temp;
  564.           fcount := index;
  565.        END;   
  566.        WHILE  i <> 0 DO
  567.            obspec := etree(tree1ptr^[fname2 + i].spec);
  568.            obspec^.ptext := ADR(path[CARDINAL(index) - 12]);
  569.            tswidth := tswidth - swidth;
  570.            DEC(index);
  571.            DEC(fcount);
  572.            DEC(i);
  573.        END;  (* WHILE *)
  574.        IF tswidth < 0.0  THEN  tswidth := 0.0 ; END;
  575.        tree1ptr^[fnslider + 1].y := INTEGER(TRUNC(tswidth));
  576.        ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);
  577.        ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
  578.      END;
  579.   END;   
  580. END Scroll12;
  581.  
  582.         
  583. (* find out which drive button was pressed and then set the drive *)
  584.  
  585. PROCEDURE SetTheDrive;
  586.  
  587. VAR
  588.   drvmap : LONGCARD;
  589.   obspec : etree;
  590.   path,clear : String;
  591.   
  592.  
  593. BEGIN
  594.   IF GetObjectState(tree1,drivea,Selected) THEN drive := 0; END;
  595.   IF GetObjectState(tree1,driveb,Selected) THEN drive := 1; END;
  596.   IF GetObjectState(tree1,drivec,Selected) THEN drive := 2; END;
  597.   IF GetObjectState(tree1,drived,Selected) THEN drive := 3; END;
  598.   IF GetObjectState(tree1,drivee,Selected) THEN drive := 4; END;
  599.   IF GetObjectState(tree1,drivef,Selected) THEN drive := 5; END;
  600.   IF GetObjectState(tree1,driveg,Selected) THEN drive := 6; END;
  601.   IF GetObjectState(tree1,driveh,Selected) THEN drive := 7; END;
  602.   IF GetObjectState(tree1,drivei,Selected) THEN drive := 8; END;
  603.   IF GetObjectState(tree1,drivej,Selected) THEN drive := 9; END;
  604.   IF GetObjectState(tree1,drivek,Selected) THEN drive := 10; END;
  605.   IF GetObjectState(tree1,drivel,Selected) THEN drive := 11; END;
  606.   IF GetObjectState(tree1,drivem,Selected) THEN drive := 12; END;
  607.   IF GetObjectState(tree1,driven,Selected) THEN drive := 13; END;
  608.   IF GetObjectState(tree1,driveo,Selected) THEN drive := 14; END;
  609.   IF GetObjectState(tree1,drivep,Selected) THEN drive := 15; END;
  610.   GrafMouse(HourGlass,NIL);
  611.   SetDrv(drive,drvmap);
  612.   GetDrv(defaultdrive);
  613.   count := 0;
  614.   fcount := 12;
  615.        ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);  
  616.        ClearArray;
  617.        Path := '\*.*';
  618.        ShowPath(Path);
  619.        MakePath(Path);
  620.        Directory;
  621.        index := 12;
  622.        CalcSliderSize;
  623.        ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
  624.        ClearSelection;
  625.        GrafMouse(Arrow,NIL);
  626. END SetTheDrive;
  627.  
  628. PROCEDURE FirstPath;
  629.  
  630.   BEGIN 
  631.     Concat('\',filename,r1);
  632.     Concat(r1,'\*.*',Path);
  633.     p1 := Path;
  634.   END FirstPath;
  635.  
  636. PROCEDURE SecondPath;
  637.  
  638.   BEGIN
  639.     Concat('\',filename,r2);
  640.     Concat(r1,r2,Temp1);
  641.     Concat(Temp1,'\*.*',Path);
  642.     p2 := Path;
  643.   END SecondPath;
  644.  
  645. PROCEDURE ThirdPath;
  646.  
  647. BEGIN
  648.    Concat('\',filename,r3);
  649.    Concat(Temp1,r3,Temp2);
  650.    Concat(Temp2,'\*.*',Path);
  651.    p3 := Path;
  652. END ThirdPath;
  653.  
  654. PROCEDURE FourthPath;
  655.  
  656. BEGIN
  657.   Concat('\',filename,r4);
  658.   Concat(Temp2,r4,Temp3);
  659.   Concat(Temp3,'\*.*',Path);
  660.   p4 := Path;
  661. END FourthPath;
  662.            
  663. (* move the file name in the directory and display it as the selected *)
  664. (* file name *)
  665.  
  666. PROCEDURE MoveName(fname : INTEGER);
  667.  
  668. VAR
  669.  fnameobspec,selectobspec,sourceobspec,fromobspec : etree;
  670.  filenameaddr,sfilename : POINTER TO String;
  671.  fnamestr,sourcename,nothin : String;
  672.  f,p : BOOLEAN;
  673.  i,l : INTEGER;
  674.  where,start : CARDINAL;
  675.                              
  676. BEGIN
  677.   fnameobspec := etree(tree1ptr^[fname + 1].spec);
  678.   filenameaddr := fnameobspec^.ptext;
  679.   filename := filenameaddr^;
  680.   match := CHR(5);
  681.   (* found a folder, open it up and display the contents *)
  682.   IF Pos(filename,match,0,where) THEN
  683.      ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
  684.      ObjectChange(tree1ptr,fname,0,x,y,w,h,selected,1);
  685.      IF count < 4 THEN              
  686.             INC(count);END;
  687.      Delete(filename,0,2);
  688.      IF count < 5 THEN
  689.         CASE count OF
  690.            1 : FirstPath;|   
  691.            2 : SecondPath;|          
  692.            3 : ThirdPath;| 
  693.            4 : FourthPath; 
  694.          END; (* CASE *)
  695.          ClearArray;
  696.          ShowPath(Path);
  697.          MakePath(Path);
  698.          Directory;
  699.          CalcSliderSize;
  700.          index := 12;
  701.          fcount := 12;
  702.          ObjectChange(tree1ptr,fname,0,x,y,w,h,Normal,1);
  703.          ObjectDraw(tree1ptr,fname,1,x,y,w,h);
  704.          ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
  705.          ClearSelection;
  706.      END;
  707.   ELSE 
  708.      IF NOT Pos(filename,match,0,where) THEN
  709.        Delete(filename,0,2);
  710.        IF Pos(filename,' ',0,where) THEN
  711.           FOR l := where TO Length(filename) DO
  712.               Delete(filename,where,1);
  713.           END; (* FOR  *)
  714.       END; (* IF *)
  715.       nothin := '';
  716.       IF Compare(filename,nothin) <> Equal THEN
  717.          selectobspec := etree(tree1ptr^[ftoname + 1].spec);
  718.          selectobspec^.ptext := ADR(filename);
  719.          (* draw the file name that is selected *)
  720.          ObjectDraw(tree1ptr,ftoname,1,x,y,w,h);
  721.          (* select the file name in the directory as the mouse passes *)
  722.          ObjectChange(tree1ptr,fname,0,x,y,w,h,selected,1);
  723.          (* deselect the file name in the directory as the mouse passes *) 
  724.          IF fname > fnametemp THEN
  725.           ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);END;
  726.          IF fname < fnametemp THEN
  727.           ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);END;
  728.          fnametemp := fname;       
  729.        END;  
  730.     END;   
  731.   END; (* IF ELSE *)       
  732. END MoveName;
  733.  
  734.  
  735. (* holds the previous sub directories *)
  736.  
  737. PROCEDURE FilePath;
  738.  
  739. BEGIN
  740.    ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
  741.    IF count > 0  THEN
  742.       CASE count OF
  743.        1 : Path := '\*.*';
  744.            p1 := '';|
  745.        
  746.        2 : Path := p1;
  747.            p2 := '';|
  748.            
  749.        3 : Path := p2;
  750.            p3 := '';|
  751.        
  752.        4 : Path := p3;
  753.            p4 := '';
  754.      END;
  755.      IF count >= 1 THEN
  756.         DEC(count);END;             
  757.      ClearArray;
  758.      ShowPath(Path);
  759.      MakePath(Path);
  760.      Directory;
  761.      index := 12;
  762.      fcount := 12;
  763.      CalcSliderSize;
  764.      ObjectDraw(tree1ptr,fwind,2,x,y,w,h);
  765.      ClearSelection;
  766.    END; 
  767. END FilePath;  
  768.  
  769. (* print a path to the printer *)
  770.  
  771. PROCEDURE PrintThePath;
  772.  
  773. VAR
  774.   result : INTEGER;
  775.   blanks,blank,rblank,astek, 
  776.   rpath,path,rrpath,single,double,tsizestr,temppathstr : String;
  777.   l,i,t,atrib,where,start : CARDINAL;
  778.  
  779. BEGIN
  780.   WriteString('PATH: ');
  781.   temppathstr := pathstr;
  782.       match := ' ';
  783.       start := 0;
  784.       where := 0;
  785.       FOR i := 0 TO Length(temppathstr) DO
  786.           IF Pos(temppathstr,match,start,where) THEN
  787.           Delete(temppathstr,where,1); END;
  788.           INC(start); 
  789.       END; (* FOR *)
  790.   WriteString(temppathstr);
  791.   WriteLn;
  792.   WriteLn;
  793.   REPEAT
  794.     WITH dtarecord DO
  795.        single := '.';
  796.        double := '..';
  797.        IF (Compare(name,single) # Equal) AND 
  798.           (Compare(name,double) # Equal) THEN
  799.           path := name;
  800.           IF Length(path) < 13 THEN
  801.              FOR t := Length(path) TO 12 DO
  802.               Concat(rblank,' ',rblank);
  803.              END; (* FOR *)
  804.              Concat(path,rblank,rpath);
  805.              rblank := '';   
  806.           END; (* IF *)
  807.           atrib := CARDINAL(attrib);
  808.           IF atrib = 16 THEN
  809.              Concat('*',rpath,rrpath);
  810.           ELSE
  811.              Concat(' ',rpath,rrpath);
  812.           END; (* IF *)                                  
  813.           INC(ct);
  814.           WriteString(rrpath);
  815.           WriteString(' ');
  816.           WriteLongCard(size,6);
  817.           WriteString('  ');
  818.           tsize := tsize + size;
  819.           IF ct = 3 THEN 
  820.              WriteLn;
  821.              ct := 0;
  822.           END;(* IF *)
  823.        END; (* IF *)  
  824.     END; (* WITH *)
  825.     SNext(result);
  826.   UNTIL result < 0;
  827.   ct := 0;
  828.   WriteLn;
  829.   WriteLn;
  830.   WriteLongCard(tsize,8);
  831.   WriteString(' Bytes used in ');
  832.   WriteString(temppathstr);
  833.   WriteLn;
  834.   tsize := 0;
  835. END PrintThePath;
  836.  
  837.  
  838. PROCEDURE HardCopy;
  839.  
  840. VAR
  841.   addr : ADDRESS;
  842.   rprint : BOOLEAN;
  843.   
  844. BEGIN
  845.   SetDTA(ADR(dtarecord));
  846.   SFirst(pathstr,16,result);
  847.   rprint := BCosStat(PRT);
  848.   GrafMouse(HourGlass,NIL);
  849.   IF rprint = TRUE THEN
  850.      OpenOutputFile("PRN:");
  851.      WriteLn;
  852.         PrintThePath;
  853.         WriteLn;
  854.         OpenOutputFile("CON:");
  855.    ELSE
  856.      showit := FormAlert(1,"[1][Printer is not|responding!][ OK ]");
  857.    END; (* IF *)
  858.    GrafMouse(Arrow,NIL);
  859.    ObjectChange(tree1ptr,fprint,0,x,y,w,h,Normal,1);
  860. END HardCopy;
  861.  
  862. (* move the slider *)
  863.  
  864. PROCEDURE MoveSlider;
  865.  
  866. VAR
  867.    i,sw,sh,tw,th,fx,fy,trackx,tracky,sliderx,slidery,
  868.    curyoff : INTEGER;
  869.    thestring : String;
  870.    obspec : etree;
  871.    count : REAL;
  872.       
  873. BEGIN
  874.    ObjectChange(tree1ptr,fnametemp,0,x,y,w,h,Normal,1);
  875.    sw := tree1ptr^[fnslider + 1].width + 1;
  876.    sh := tree1ptr^[fnslider + 1].height;
  877.    tw := tree1ptr^[fntrack + 1].width;
  878.    th := tree1ptr^[fntrack + 1].height;     
  879.    ObjectOffset(tree1ptr,fntrack,trackx,tracky);
  880.    ObjectOffset(tree1ptr,fnslider,sliderx,slidery);
  881.    GrafDragBox(sw,sh,sliderx,slidery,trackx,tracky,tw,th,fx,fy);
  882.    tree1ptr^[fnslider + 1].y := fy - tracky;
  883.    ObjectDraw(tree1ptr,fntrack,1,x,y,w,h);
  884.    count := FLOAT(CARDINAL(fy - tracky)) / swidth;
  885.    index := INTEGER(TRUNC(count));
  886.    fcount := index;
  887.    curyoff := tree1ptr^[fnslider + 1].y;
  888.    tswidth := count * swidth;
  889.       FOR i := 1 TO 12 DO
  890.           INC(fcount);
  891.           INC(index);
  892.           obspec := etree(tree1ptr^[fname2 + i].spec);
  893.           obspec^.ptext := ADR(path[index]);
  894.       END; (* FOR *)
  895.       ObjectDraw(tree1ptr,fwind,1,x,y,w,h);
  896. END MoveSlider;
  897.  
  898. (* load the resource file *)
  899.  
  900. PROCEDURE LoadResource;
  901.  
  902. CONST 
  903.    RFilename = ':\FLSCLR.RSC';
  904.  
  905. VAR 
  906.    rname,pathdrive,path : String;
  907.    
  908. BEGIN
  909.   GetDrv(defaultdrive);
  910.   pathdrive := CHR(ORD(defaultdrive) + ORD('A'));
  911.   rname := RFilename;
  912.   Concat(pathdrive,rname,path);
  913.   ResourceLoad(path);
  914.   IF AESCallResult = 0 THEN
  915.      loaded  := FALSE; ELSE loaded := TRUE; END;
  916. END LoadResource;
  917.  
  918. (* initalize the program *)
  919.                           
  920. PROCEDURE Initialize;
  921.  
  922.   VAR
  923.      fromobspec : etree;
  924.      path,blank : String;
  925.      drivemap : LONGCARD;
  926.      
  927. BEGIN
  928.   blank := '';
  929.   fcount := 12;
  930.   ResourceGetAddr(0,tree1,tree1ptr);
  931.   initialized := FALSE;
  932.   GetDrv(defaultdrive);
  933.   SetDrv(defaultdrive,drivemap);
  934.   drv := DriveMap();
  935.   FOR d := 0 TO 15 DO
  936.         IF d IN drv THEN
  937.            ObjectChange(tree1ptr,drivea + d,0,x,y,w,h,Normal,0);END;
  938.   END; (* FOR *)         
  939.   ObjectChange(tree1ptr,drivea + INTEGER(defaultdrive),0,x,y,w,h,selected,0);
  940.   fnametemp := fname2;       
  941.   path := '\*.*';
  942.   MakePath(path);
  943.   ShowPath(path);
  944.   Directory;
  945.   fromobspec := etree(tree1ptr^[ftoname + 1].spec);
  946.   fromobspec^.ptext := ADR(blank);
  947.   CalcSliderSize;
  948.   initialized := TRUE;
  949.   index := 12;
  950.   IF NOT CreateHeap(256 * 1024,TRUE) THEN HALT;END;
  951. END Initialize;   
  952.  
  953. (* the event loop *)
  954.  
  955. PROCEDURE EventLoop;
  956.  
  957. BEGIN
  958.     FormCenter(tree1ptr,x,y,w,h);
  959.     FormDialogue(0,0,0,0,0,x,y,w,h);
  960.     FormDialogue(1,0,0,0,0,x,y,w,h);
  961.     ObjectDraw(tree1ptr,0,2,x,y,w,h);
  962.     GrafMouse(Arrow,NIL);
  963.   REPEAT
  964.     showit := FormDo(tree1ptr,ftoname);
  965.     CASE showit OF
  966.            fup             : ScrollUp;|
  967.            fdown           : ScrollDown;|
  968.            fname2..fname13 : MoveName(showit);|
  969.            fpath           : FilePath;|
  970.            fprint          : HardCopy;|
  971.            fnslider        : MoveSlider;|
  972.            fntrack         : Scroll12;|
  973.            drivea..drivep  : SetTheDrive;|
  974.     END; (* CASE *)
  975.     
  976.   UNTIL GetObjectState(tree1,exit,Selected); 
  977.   FormDialogue(2,0,0,0,0,x,y,w,h);
  978.   FormDialogue(3,0,0,0,0,x,y,w,h);
  979. END EventLoop;
  980.     
  981. BEGIN (* MAIN PROGRAM *)
  982.      LoadResource;
  983.      IF loaded THEN
  984.         Initialize;
  985.         EventLoop;
  986.         ResourceFree; 
  987.      ELSE
  988.       showit := FormAlert(0,"[1][Resource file not found!][ OK ]");END;   
  989. END FileSelector.
  990.